;; import functions/standard.scm lists/list-sets.scm

(define p display)
(define nl newline)

(define (print-sudoku s)
  (let ((i 0))
    (let ((next (lambda ()
		  (let ((v (vector-ref s i)))
		    (set! i (+ i 1))
		    (if (and (number? v) (not (= 0 v)))
			(p v)
			(p " "))))))
      (next) (next) (next) (p "|") (next) (next) (next) (p "|") (next) (next) (next) (nl)
      (next) (next) (next) (p "|") (next) (next) (next) (p "|") (next) (next) (next) (nl)
      (next) (next) (next) (p "|") (next) (next) (next) (p "|") (next) (next) (next) (nl)
      (p "---+---+---") (nl)
      (next) (next) (next) (p "|") (next) (next) (next) (p "|") (next) (next) (next) (nl)
      (next) (next) (next) (p "|") (next) (next) (next) (p "|") (next) (next) (next) (nl)
      (next) (next) (next) (p "|") (next) (next) (next) (p "|") (next) (next) (next) (nl)
      (p "---+---+---") (nl)
      (next) (next) (next) (p "|") (next) (next) (next) (p "|") (next) (next) (next) (nl)
      (next) (next) (next) (p "|") (next) (next) (next) (p "|") (next) (next) (next) (nl)
      (next) (next) (next) (p "|") (next) (next) (next) (p "|") (next) (next) (next) (nl))))

(define (coord->row c) (* 9 (quotient c 9)))
(define (coord->col c) (modulo c 9))
(define (coord->box c)
  (+ (* (quotient (coord->col c) 3) 3)
     (* (quotient (coord->row c) (* 3 9)) (* 3 9))))

(define (across-row r f)
  (f (+ r 0)) (f (+ r 1)) (f (+ r 2)) (f (+ r 3)) (f (+ r 4)) (f (+ r 5)) (f (+ r 6)) (f (+ r 7)) (f (+ r 8)))

(define (across-col c f)
  (f (+ c 0))
  (f (+ c 9))
  (f (+ c 18))
  (f (+ c 27))
  (f (+ c 36))
  (f (+ c 45))
  (f (+ c 54))
  (f (+ c 63))
  (f (+ c 72)))

(define (across-box b f)
  (f (+ b 0))  (f (+ b 1))  (f (+ b 2))
  (f (+ b 9))  (f (+ b 10)) (f (+ b 11))
  (f (+ b 18)) (f (+ b 19)) (f (+ b 20)))

(define digits '(1 2 3 4 5 6 7 8 9))

(define to-propagate '())
(define (pre-process s)
  (for 0 81
       (lambda (i)
	 (let ((v (vector-ref s i)))
	   (if (= 0 v)
	       (vector-set! s i digits)
	       (set! to-propagate (cons i to-propagate)))))))

(define (propagate s coordinate)
  (let* ((val (vector-ref s coordinate))
	 (remove-val (lambda (i)
		       (let ((options (vector-ref s i)))
			 (when (list? options)
			   (let ((result (set-remove-element options val)))
			     (if (= 1 (length result))
				 (begin
				   (set! to-propagate (cons i to-propagate))
				   (vector-set! s i (car result)))
				 (vector-set! s i result))))))))
    (across-row (coord->row coordinate) remove-val)
    (across-col (coord->col coordinate) remove-val)
    (across-box (coord->box coordinate) remove-val)))

(define (solve! s)
  (if (null? to-propagate)
      #t
      (let ((c (car to-propagate)))
	(set! to-propagate (cdr to-propagate))
	(propagate s c)
	(solve! s))))

(define sudoku-problem
  ;; https://projecteuler.net/problem=96
  (list->vector '(0 0 3   0 2 0   6 0 0
		  9 0 0   3 0 5   0 0 1
		  0 0 1   8 0 6   4 0 0

		  0 0 8   1 0 2   9 0 0
		  7 0 0   0 0 0   0 0 8
		  0 0 6   7 0 8   2 0 0

		  0 0 2   6 0 9   5 0 0
		  8 0 0   2 0 3   0 0 9
		  0 0 5   0 1 0   3 0 0)))

;; for debugging the arithmetic stuff:
;; (for 0 81 (lambda (i) (vector-set! sudoku-problem i (coord->box i))))

(print-sudoku sudoku-problem)
(newline)
(print "solving...")
(newline)
(pre-process sudoku-problem)
(solve! sudoku-problem)
(print-sudoku sudoku-problem)
